home *** CD-ROM | disk | FTP | other *** search
/ Planet Source Code Jumbo …e CD Visual Basic 1 to 7 / 5_2007-2008.ISO / data / Zips / MBFolderBr2116746142008.psc / MBFolderBrowser 1.0.0 / FolderBrowser.ctl next >
Text File  |  2008-06-14  |  9KB  |  306 lines
  1. VERSION 5.00
  2. Begin VB.UserControl FolderBrowser 
  3.    ClientHeight    =   3180
  4.    ClientLeft      =   0
  5.    ClientTop       =   0
  6.    ClientWidth     =   4245
  7.    InvisibleAtRuntime=   -1  'True
  8.    ScaleHeight     =   3180
  9.    ScaleWidth      =   4245
  10.    ToolboxBitmap   =   "FolderBrowser.ctx":0000
  11.    Begin VB.Image imgBackGround 
  12.       Height          =   810
  13.       Left            =   0
  14.       Picture         =   "FolderBrowser.ctx":0312
  15.       Stretch         =   -1  'True
  16.       Top             =   0
  17.       Width           =   900
  18.    End
  19. End
  20. Attribute VB_Name = "FolderBrowser"
  21. Attribute VB_GlobalNameSpace = False
  22. Attribute VB_Creatable = True
  23. Attribute VB_PredeclaredId = False
  24. Attribute VB_Exposed = True
  25. Option Explicit
  26.  
  27. '=============================================
  28. 'API's
  29.  
  30. Private Const BIF_BROWSEFORCOMPUTER As Long = &H1000
  31. Private Const BIF_BROWSEFORPRINTER As Long = &H2000
  32. Private Const BIF_BROWSEINCLUDEFILES As Long = &H4000
  33. Private Const BIF_BROWSEINCLUDEURLS As Long = &H80
  34. Private Const BIF_DONTGOBELOWDOMAIN As Long = &H2
  35. Private Const BIF_EDITBOX As Long = &H10
  36. Private Const BIF_NEWDIALOGSTYLE As Long = &H40
  37. Private Const BIF_RETURNFSANCESTORS As Long = &H8
  38. Private Const BIF_RETURNONLYFSDIRS As Long = &H1
  39. Private Const BIF_SHAREABLE As Long = &H8000
  40. Private Const BIF_STATUSTEXT As Long = &H4
  41. Private Const BIF_USENEWUI As Long = &H40
  42. Private Const BIF_VALIDATE As Long = &H20
  43.  
  44. Private Const MAX_PATH = 500
  45.  
  46. Private Type TBrowseInfo
  47.  
  48.   hwndOwner As Long
  49.   pidlRoot As Long
  50.   pszDisplayName As String
  51.   lpszTitle As String
  52.   ulFlags As Long
  53.   lpfn As Long
  54.   lParam As Long
  55.   iImage As Long
  56.   
  57. End Type
  58.  
  59. Private Declare Function SHBrowseForFolder Lib "shell32" (lpbi As TBrowseInfo) As Long
  60. Private Declare Function SHGetPathFromIDList Lib "shell32" (ByVal pidList As Long, ByVal lpBuffer As String) As Long
  61. Private Declare Sub CoTaskMemFree Lib "ole32.dll" (ByVal hMem As Long)
  62.  
  63. '=======================================
  64. 'Default Property Values:
  65.  
  66. Const m_def_IncludeFiles = True
  67. Const m_def_EditBox = True
  68. Const m_def_DisplayName = ""
  69. Const m_def_Title = "MBFolderBrowser"
  70. Const m_def_FolderPath = ""
  71. Const m_def_MakeNewFolderButton = True
  72. Const m_def_IncludeUrls = False
  73.  
  74. '=======================================
  75. 'Property Variables:
  76.  
  77. Dim m_IncludeFiles As Boolean
  78. Dim m_EditBox As Boolean
  79. Dim m_MakeNewFolderButton As Boolean
  80. Dim m_IncludeUrls As Boolean
  81.  
  82. Dim m_DisplayName As String
  83. Dim m_Title As String
  84. Dim m_FolderPath As String
  85.  
  86. '=============================================
  87.  
  88. Private Sub UserControl_Resize()
  89.  
  90.     UserControl.Height = imgBackGround.Height
  91.     UserControl.Width = imgBackGround.Width
  92.  
  93. End Sub
  94.  
  95. Public Property Get IncludeFiles() As Boolean
  96. Attribute IncludeFiles.VB_Description = "Return\\sets the folder browser include files or not."
  97.  
  98.     IncludeFiles = m_IncludeFiles
  99.     
  100. End Property
  101.  
  102. Public Property Let IncludeFiles(ByVal New_IncludeFiles As Boolean)
  103.  
  104.     m_IncludeFiles = New_IncludeFiles
  105.     PropertyChanged "IncludeFiles"
  106.     
  107. End Property
  108.  
  109. Public Property Get EditBox() As Boolean
  110. Attribute EditBox.VB_Description = "Return\\sets the visibility of Editbox button in folder browser."
  111.  
  112.     EditBox = m_EditBox
  113.     
  114. End Property
  115.  
  116. Public Property Let EditBox(ByVal New_EditBox As Boolean)
  117.  
  118.     m_EditBox = New_EditBox
  119.     PropertyChanged "EditBox"
  120.     
  121. End Property
  122.  
  123. Public Property Get DisplayName() As String
  124. Attribute DisplayName.VB_Description = "Return\\sets the DisplayName of item selected."
  125.  
  126.     DisplayName = m_DisplayName
  127.     
  128. End Property
  129.  
  130. Public Property Let DisplayName(ByVal New_DisplayName As String)
  131.  
  132.     m_DisplayName = New_DisplayName
  133.     PropertyChanged "DisplayName"
  134.     
  135. End Property
  136.  
  137.  
  138. Public Property Get Title() As String
  139. Attribute Title.VB_Description = "Return\\sets the text displayed in folder browser's title bar."
  140.  
  141.     Title = m_Title
  142.     
  143. End Property
  144.  
  145. Public Property Let Title(ByVal New_Title As String)
  146.  
  147.     m_Title = New_Title
  148.     PropertyChanged "Title"
  149.     
  150. End Property
  151.  
  152. Public Property Get FolderPath() As String
  153. Attribute FolderPath.VB_Description = "Return the path of folder selected."
  154.  
  155.     FolderPath = m_FolderPath
  156.     
  157. End Property
  158.  
  159. Public Property Let FolderPath(ByVal New_FolderPath As String)
  160.  
  161.     m_FolderPath = New_FolderPath
  162.     PropertyChanged "FolderPath"
  163.     
  164. End Property
  165.  
  166. Public Property Get MakeNewFolderButton() As Boolean
  167. Attribute MakeNewFolderButton.VB_Description = "Return\\sets the visibility of MakeNewFolder button in folder browser."
  168.  
  169.     MakeNewFolderButton = m_MakeNewFolderButton
  170.     
  171. End Property
  172.  
  173. Public Property Let MakeNewFolderButton(ByVal New_MakeNewFolderButton As Boolean)
  174.  
  175.     m_MakeNewFolderButton = New_MakeNewFolderButton
  176.     PropertyChanged "MakeNewFolderButton"
  177.     
  178. End Property
  179.  
  180. Public Property Get IncludeUrls() As Boolean
  181. Attribute IncludeUrls.VB_Description = "Return\\sets the folder browser include urls or not."
  182.  
  183.     IncludeUrls = m_IncludeUrls
  184.     
  185. End Property
  186.  
  187. Public Property Let IncludeUrls(ByVal New_IncludeUrls As Boolean)
  188.  
  189.     m_IncludeUrls = New_IncludeUrls
  190.     PropertyChanged "IncludeUrls"
  191.     
  192. End Property
  193.  
  194. Public Function BrowseFolder() As Boolean
  195.  
  196.     Dim Buffer As String
  197.     Dim BrowseInfo As TBrowseInfo
  198.     Dim IdList As Long
  199.     
  200.     With BrowseInfo
  201.     
  202.       .pidlRoot = 0
  203.       .pszDisplayName = String(MAX_PATH, 0)
  204.       .hwndOwner = UserControl.hWnd
  205.       .lpszTitle = m_Title
  206.       
  207.       '-------------
  208.       'Set flag
  209.       
  210.       If m_EditBox = True Then
  211.           .ulFlags = .ulFlags Or BIF_EDITBOX
  212.       End If
  213.       If m_IncludeFiles = True Then
  214.           .ulFlags = .ulFlags Or BIF_BROWSEINCLUDEFILES
  215.       End If
  216.       If m_IncludeUrls = True Then
  217.           .ulFlags = .ulFlags Or BIF_BROWSEINCLUDEURLS
  218.       End If
  219.       If m_MakeNewFolderButton = True Then
  220.           .ulFlags = .ulFlags Or BIF_NEWDIALOGSTYLE
  221.       End If
  222.       '-------------
  223.       
  224.     End With
  225.     
  226.     IdList = SHBrowseForFolder(BrowseInfo)
  227.   
  228.     If IdList Then
  229.   
  230.         Buffer = String$(MAX_PATH, 0)
  231.         SHGetPathFromIDList IdList, Buffer
  232.         CoTaskMemFree IdList
  233.         
  234.         BrowseFolder = True
  235.     
  236.     Else
  237.      
  238.         BrowseFolder = False
  239.         Exit Function
  240.      
  241.     End If
  242.   
  243.     m_FolderPath = Buffer
  244.     m_FolderPath = Left(m_FolderPath, InStr(1, m_FolderPath, Chr(0)) - 1)
  245.     m_DisplayName = BrowseInfo.pszDisplayName
  246.  
  247. End Function
  248.  
  249. 'Initialize Properties for User Control
  250. Private Sub UserControl_InitProperties()
  251.  
  252.     m_IncludeFiles = m_def_IncludeFiles
  253.     m_EditBox = m_def_EditBox
  254.     m_MakeNewFolderButton = m_def_MakeNewFolderButton
  255.     m_IncludeUrls = m_def_IncludeUrls
  256.     
  257.     m_DisplayName = m_def_DisplayName
  258.     m_Title = m_def_Title
  259.     m_FolderPath = m_def_FolderPath
  260.     
  261. End Sub
  262.  
  263. 'Load property values from storage
  264. Private Sub UserControl_ReadProperties(PropBag As PropertyBag)
  265.  
  266.     m_IncludeFiles = PropBag.ReadProperty("IncludeFiles", m_def_IncludeFiles)
  267.     m_EditBox = PropBag.ReadProperty("EditBox", m_def_EditBox)
  268.     m_MakeNewFolderButton = PropBag.ReadProperty("MakeNewFolderButton", m_def_MakeNewFolderButton)
  269.     m_IncludeUrls = PropBag.ReadProperty("IncludeUrls", m_def_IncludeUrls)
  270.     
  271.     m_DisplayName = PropBag.ReadProperty("DisplayName", m_def_DisplayName)
  272.     m_Title = PropBag.ReadProperty("Title", m_def_Title)
  273.     m_FolderPath = PropBag.ReadProperty("FolderPath", m_def_FolderPath)
  274.     
  275. End Sub
  276.  
  277. 'Write property values to storage
  278. Private Sub UserControl_WriteProperties(PropBag As PropertyBag)
  279.  
  280.     Call PropBag.WriteProperty("IncludeFiles", m_IncludeFiles, m_def_IncludeFiles)
  281.     Call PropBag.WriteProperty("EditBox", m_EditBox, m_def_EditBox)
  282.     Call PropBag.WriteProperty("MakeNewFolderButton", m_MakeNewFolderButton, m_def_MakeNewFolderButton)
  283.     Call PropBag.WriteProperty("IncludeUrls", m_IncludeUrls, m_def_IncludeUrls)
  284.     
  285.     Call PropBag.WriteProperty("DisplayName", m_DisplayName, m_def_DisplayName)
  286.     Call PropBag.WriteProperty("Title", m_Title, m_def_Title)
  287.     Call PropBag.WriteProperty("FolderPath", m_FolderPath, m_def_FolderPath)
  288.     
  289. End Sub
  290.  
  291.  
  292. Public Sub About()
  293. Attribute About.VB_UserMemId = -552
  294.  
  295.     Dim FrmAbObj As frmAbout
  296.     
  297.     Set FrmAbObj = New frmAbout
  298.     
  299.     FrmAbObj.Show vbModal
  300.      
  301.     Unload FrmAbObj
  302.     
  303.     Set FrmAbObj = Nothing
  304.  
  305. End Sub
  306.